perm filename MJUST.FAI[RST,LCS] blob
sn#215096 filedate 1976-05-11 generic text, type T, neo UTF8
00100 C****** MOVER, MVBEAM, MVBX, RTLINE, EXTEN, CLEFS
00200 SUBROUTINE MOVER
00300 IMPLICIT INTEGER(A-Q,S-Z)
00400 DIMENSION R(2,200),IR(2,200),NP(500)
00500 REAL POS,EXTEN,PRCNT,ACCX
00600 COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK/STF/RSTFAC(-3/4),RSTJ2
00700 COMMON/XRN/RN(4000) /KJY/ KY,JY
00800 COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
00900 COMMON/POSI/STFF(-3/4),JJ2,POS/PTR/PWDS(250),ITEM,LL,I,IX
01000 COMMON/ALF/INP(46),ACCX,ML,RRT,RZRO,RCNT,RJSZ,ROV,RSPC,KN,RA,RB,
01100 1 JLDGR,LDGR,JX,RW,RX,RY,RZ,JJ,RD,RQ,RE,RZZ,RN3,RN6,RV,RQ6
01200 EQUIVALENCE (R5,RJQ(3)),(R6,RJQ(4)),(R7,RJQ(5)),(R4,RJQ(2))
01300 1,(R3,RJQ(1)),(R8,RJQ(6)),(R9,RJQ(7)),(R11,RJQ(9))
01400 1,(IR,R,RN(3501)),(NP,RN(3000))
01500 DATA F78F/'(78F)'/,FA1/'(A1 )'/,FA5/'(A5 )'/,RSP/.5/,RI/4.5/
01600
01700 JJ2=999
01800 J2=0
01900 ASK=-1
02000 C 99=BACKUP
02100 6 CALL VLINE(R2,R4,R5,R6)
02200 IF(R2.GE.99)RETURN
02300 IF(INP(1).EQ.'J')GO TO 12
02400 TYPE 5
02500 ACCEPT F78F,R7,R8,R9,R11
02600 RDIS=0
02700 REREAD FA1,L
02800 C FOR LPEN TYPE 'L'. BUT 4TH # MUST APPEAR WHEN NEEDED.
02900 IF(L.EQ.'B')GO TO 6
03000 IF(R7.GE.99)GO TO 6
03100 IF(R2.GT.4)R7=R2
03200 IF(R7.NE.R2)TYPE 1200,R7
03300 1201 IF(L.NE.'L')GO TO 66
03400 DO 67 K=1,2
03500 R8=RY
03600 CALL LPEN(R7,RY,RX)
03700 67 IF(R7.GE.99)GO TO 6
03800 R9=RY
03900 CC66 JJ2=1
04000 66 NST=1
04100 C FOR START OF LOOP (1 UNLESS USING COPYIT)
04200 IF(INP(1).NE.'C')GO TO 68
04300 NST=ITEM+1
04400 CALL COPYIT
04500 68 IF(R11.NE.0)CALL UPDN(NST)
04600 JJ=0
04700 IF(R4.NE.R8.OR.R5.NE.R9)JJ=-1
04800 JY=0
04900 C JY IS CHANGED IN GETPTS
05000 IF(JJ)CALL GETPTS(NST)
05010 IF(R2.NE.R7)CALL STFCH
05050 IF(JY.NE.0)GO TO 1
05060 7 IF(JJ2.EQ.999)JJ2=-1
05070 RETURN
05200 CC IF(JY.EQ.0)RETURN
05300 1 CALL MOVIT
05400 RETURN
05410 MJUST: 0
05500 SKIPE 3,R4 ;12 IF(R4.EQ.0)R4=.001
05510 JRST .+3
05550 MOVE 3,[0.001]
05575 MOVEM 3,R4
05600 SKIPE 2,R5 ; IF(R5.EQ.0)R5=200
05620 JRST .+3
05640 MOVE 2,[200.0]
05660 MOVEM 2,R5
05700 SETZM RCNT# ; RCNT=0
05800 MOVEM 2,RRT# ; RRT=R5
05900 MOVEM 3,RZRO# ; RZRO=R4
06000 MOVE [4.5] ; RJSZ=RI
06020 MOVEM RJSZ#
06100 JSA 16,GETPTS ; CALL GETPTS(1)
06120 JUMP [1]
06200 SKIPN KJY+1 ; IF(JY.EQ.0)GO TO 7
06220 JRST MV7 ;RETURN IF NO ITEMS FOUND TO DEAL WITH.
06300 MOVE RRT ; ROV=RRT
06320 MOVEM ROV#
06400 MOVE [1.0] ; PRCNT=1.
06420 MOVEM PRCNT#
06500 MOVE .COMM. ; R7=R2
06520 MOVEM .COMM.+=8
06600 SETZM .COMM.+7 ; R6=0
06700 SETZM .COMM.=12 ; R11=0
06800 MV19: MOVE RCNT ;19 IF(RCNT.GT.9)GO TO 101
06820 CAILE =9 ; MAKE RCNT AN INTEGER!
06840 JRST MV101
06900 MOVN [0.06] ; RJSZ=RJSZ-.06
06920 FADRM RJSZ
07000 MOVE PRCNT ; RP=PRCNT
07020 MOVEM RP#
07100 AOS RCNT ; RCNT=RCNT+1
07200 ; TEMPORARY COUNTER
07300 JSA 16,JTYPE ; TYPE F78F,RCNT
07320 JUMP RCNT
07400
07500 MOVNI 15,3 DO 11 KN=-3,4
07600 MVX11: SETZM RSPC# ; RSPC=0
07700 MOVE 14,15 ; R8=KN
07720 TLC 14,232000
07740 FADR 14,14 ;14 IS R8 FOR NOW
07800 SETO 12, ; N=0 12 IS N -- START WITH -1
07900
08000 MOVEI 13,1 ; DO 2 K=1,KY
08100 MVX2: MOVE 11,XRN+=2999(13) ; 11 IS L L=NP(K)
08200 MOVE 10,XRN-1(11) ; 10 IS RL RL=RN(L)
08300 MOVE 7,XRN(11) ; 7 IS RA RA=RN(L+1)
08400 MOVE 6,XRN+2(11) ; 6 IS RB RB=RN(L+3)
08500 CAMN 14,XRN+1(11) ;IF(RN(L+2).EQ.R8)GO TO 77
08520 JRST MV77 ;THIS STAFF?
08700 CAME 7,[4.0] ; IF(RA.NE.4)GO TO 2
08720 JRST MV2 ; SKIPS HOMED NOTES (IN CHORDS)
09100 MV77: CAMGE 7,[3.0] ;77 IF(RA.LT.3)GO TO 10
09120 JRST MV10
09200 CAMN 7,[4.0] ; IF(RA.EQ.4)GO TO 444
09220 JRST MV444
09300 CAMN 7,[3.0] ; IF(RA.EQ.3)GO TO 333
09320 JRST MV333 ; LOOKS AT NOTES,RESTS,CLEFS,BAR LINES,KSIGS,METERS.
09500 CAMGE 7,[17.0] ; IF(RA.LT.17)GO TO 2
09520 JRST MV2
09600 JRST MV10 ; GO TO 10
09700 MV333: CAMGE 10,[3.0] ;333 IF(RL.LT.3)GO TO 10
09720 JRST MV10 ; <3 MEANS NOTHING IN P5
09900 JSA 16,AMOD ; IF(AMOD(RN(L+5),100.0).GT.3)GO TO 2
09920 JUMP XRN+4(11)
09940 JUMP [100.0]
09960 CAMLE [3.0]
09980 JRST MV2 ; NOT A REAL CLEF IF >3
10100 JRST MV10 ; GO TO 10
10200 MV444: CAMLE 10,[2.0] ;444 IF(RL.GT.2)GO TO 2
10220 JRST MV2 ; SHOULD CHECK ON BAR LINES NO MATTER WHICH STAFF
10400 MV10: AOJ 12 ;10 N=N+1
10500 MOVE 1,12 ; R(1,N)=RB
10520 IMULI 1,2
10540 MOVEM 6,XRN+=3500(1)
10600 MOVEM 11,XRN+=3501(1) ; IR(2,N)=L
10700 CAIN 12,=198 ; IF(N.EQ.200)GO TO 28
10720 JRST MV28 ; ONLY TREATS 200 ITEMS AT A TIME.
10900 MV2: CAMGE 13,KJY ;2 CONTINUE
10920 AOJA 13,MVX2
11000
11100 JUMPL 12,MV11 ; IF(N.EQ.0)GO TO 11
11200 MV28: SETZ 13, ; 28 DO 23 K=1,N
11202 MV23: MOVE 1,13
11260 IMULI 1,2
11280 CAME 2,XRN+=3501(1)
11282 JRST MV24
11300 CAME 13,12 ;23 IF(RN(IR(2,K)+1).NE.4)GO TO 24
11302 AOJA 13,MV23 ; SKIPS IF ONLY BAR LINES ON THIS STAFF
11500 JRST MV11 ; GO TO 11
11600 MV24: MOVE 2,STF+3(15) ;24 RSTJ2=RSTFAC(KN)*PRCNT
11620 FMPR 2,PRCNT
11640 MOVEM 2,STF+=8
11660 MOVE 5,12
11680 AOJ 5,
11700 JSA 16,SORT2 ; CALL SORT2(R,N)
11710 JUMP XRN+=3500
11720 JUMP 5 ; (N)
11800
11900 ; JUMP IF LAST IS A BAR LINE.
12000 SETO 13, ; K=0 (-1 NOW)
12100 SETZM JLDGR# ; JLDGR=0
12200 SETZM JX# ; JX=0
12300 MV22: AOJ 13, ;22 K=K+1
12400 MV122: MOVE 1,13 ;122 L=IR(2,K)
12420 IMULI 1,2
12440 MOVEM 11,XRN+=3501(1)
12500 MOVE 7,XRN(11) ; RA=RN(L+1)
12550 ; 7=RA IS NOW CODE NUM.
12600 SETZ 6, ; RB=0
12610 SETZM RD# ; RD=0
12655 ; RD WILL HOLD SPACE TO ADD TO PREV. ITEM, IF NEEDED.
12700 MOVE XRN+4(11) ; RX=RN(L+5)
12720 MOVEM RX# ; RX=PARAM 5
12900 MOVE XRN+6(11) ; RX6=RN(L+6)
12920 MOVEM RX6#
13000 MOVE [1.0] ; RY=1
13020 MOVEM RY#
13100 JSA 16,AMOD ; RW=AMOD(RN(L+4),100.)
13120 JUMP XRN+3(11)
13140 JUMP [100.0]
13160 MOVEM RW#
13200 CAMLE 7,[1.0] ; IF(RA.GT.1)GO TO 4
13220 JRST MV4
13300 MOVE XRN+6(11) ; RZ=RN(L+7)
13320 MOVEM RZ#
13400 MOVE JLDGR ; IF(LDGR.NE.JLDGR)JLDGR=0
13420 CAME LDGR#
13440 SETZM JLDGR
13500 SETZM LDGR# ; LDGR=0
13600 AOJ 13 ; JK=K
13640 MOVEM 13,JK#
13700 MVX32: MOVE 14,13 ; DO 32 JJ=JK+1,N+1
13750 AOJ 13 ; K=JJ
13810 MOVE 1,14 ; RB=R(1,JJ)-R(1,JJ-1)
13815 IMULI 1,2
13817 MOVE 2,XRN+=3500(1)
13818 FSBR 2,XRN+=3498(1) ; 2=RB NOW
13820 CAMLE 2,[0.1] ; IF(RB.GT.0.1)GO TO 320
13822 JRST MV320 ; PUTS THEM AT EXACT SAME POINT IF CLOSER THAN .1
13830 MOVE 3,XRN+=3498(1) ; R(1,JJ)=R(1,JJ-1)
13835 MOVEM 3,XRN+=3500(1)
13840 JRST MV32 ; GO TO 32
13900 MV320: CAMLE 2,[0.5] ; 320 IF(RB.GT.RSP)GO TO 35
13905 JRST MV35
13910 MV32: AOJ 14, ;32 CONTINUE
13955 MOVE 1,14
13977 AOJ 1,
13988 CAMGE 1,12 ; 12=N
13994 JRST MVX32 ;FOUND HOW MANY MEMBERS TO CHORD.
14100 MV35: SETZ 6, ;35 RB=0 (6)
14200 SOJ 13, ;K=K-1
14300 SETZ 10, ; RQ=0 (10)
14510 MV125: MOVM 5,XRN+3(11) ;5=RC 125 RC=ABS(RN(L+4))
14515
14520 CAMGE 5,[60.0] ; IF(RC.LT.60)GO TO 137
14525 JRST MV137
14530 CAML 5,[180.0] ; IF(RC.LT.180)RY=.6
14535 JRST .+3
14537 MOVE [0.6]
14538 MOVEM RY ;FOUND A MINI-NOTE
14600 MV137: MOVE 12,JK ;137 DO 37 JJ=JK,K-1
14700 MVX37: JUMPN 6,MV38 ; IF(RD.NE.0)GO TO 38
14800 ; FINDS ONLY HIGH OR! LOW LED. LINE.
14900 MOVE 1,12 ; JR=IR(2,JJ)
14910 SOJ 10,
14920 ADD 10,10
14930 MOVE 10,XRN+=3501(10)
15000 JSA 16,AMOD ; RW=AMOD(RN(JR+4),100.)
15010 JUMP XRN+3(10)
15020 JUMP [100.0]
15100 MOVE RW ; IF(RW.GT.12)GO TO 277
15110 CAMLE [12.0]
15120
15130 JRST MV277
15200 CAML [2.0] ; IF(RW.GE.2)GO TO 38
15210 JRST MV38
15300 MV277: SETOM LDGR ; 277 LDGR=-1
15400 CAMG [11.0] ; IF(RW.GT.11)LDGR=1
15410 JRST .+3
15420 MOVEI 1
15430 MOVEM LDGR
15500 MOVE LDGR ; IF(JLDGR.EQ.LDGR)GO TO 36
15510 CAMN JLDGR
15520 JRST MV36
15600 MOVEM JLDGR ; JLDGR=LDGR LDGR IS FOR LEDGER LINES.
15800 JRST MV38 ; GO TO 38
15900 MV36: MOVE 4,[1.5] ; 36 RD=1.5
15910 MOVEM 4,RD
16000 MOVEM 4,RQ# ; RQ=RD
16100 MV38: CAMLE 6,[2.0] ; 38 IF(RB.GT.2)GO TO 222
16110 JRST MV222 ; JUMP IF LARGE SPACE AFTER NOTE IS ALREADY SET UP.
16300 MOVE 1,XRN+6(10) ; 10=JR RZZ=RN(JR+7)
16310 MOVEM 1,RZZ#
16400 MOVE 2,XRN+4(10) ; RE=RN(JR+5)
16410 MOVEM 2,RE#
16700 CAML 6,[2.0] ; IF(RB.GE.2)GO TO 477
16710 JRST MV477
16800 CAML 1,[10.0] ; IF(RZZ.GE.10)GO TO 377
16810 JRST MV377
16900 CAML 2,[20.0] ; IF(RE.GE.20)GO TO 477
16910 JRST MV477
17000 JSA 16,AMOD ; IF(AMOD(RZZ,10.).EQ.0)GO TO 477
17010 JUMP RZZ
17020 JUMP [10.0]
17030 JUMPE MV477
17100 MV377: JSA 16,EXTEN ; 377 RB=1.5+EXTEN(RZZ)
17150 JUMP RZZ
17160 FADR [1.5]
17170 MOVE 6, ; 6=RB
17200 ; SPACE FOR DOT OR TAIL(IF STEM UP)
17300 MV47: MOVM XRN+5(10) ;477 IF(ABS(RN(JR+6)).EQ.10)RB=RB+2
17310 CAMN [10.0]
17330 FADR 6,[2.0] ;FOR CHORD TONES ON RIGHT OF STEM UP.
17500 ; LOOKS THROUGH ALL NOTES OF A CHORD.
17600 MV222: JSA 16,AMOD ; 222 IF(AMOD(RE,10.).EQ.0)GO TO 37
17610 JUMP RE
17620 JUMP [10.0]
17630 JUMPE MV37 ;JUMP IF NO ACCIS.
17800 MV425: JSA 16,EXTEN ; 425 RD=2*RY+EXTEN(RE)
17810 JUMP RE
17820 FADR RY
17830 FMPR [2.0]
17900 CAMG RQ ; IF(RQ.GT.RD)RD=RQ
17910 MOVE RQ
17920 MOVEM RD#
18000 MOVEM RQ ; RQ=RD
18100 ; FUNCT. EXTEN=AMOD(X,1.)*10.
18200 MV37: AOJ 12, ;37 CONTINUE
18210 CAMGE 12,13
18220 JRST MVX37
18300 MOVE RY ; IF(RY.NE.1)RB=RB-.5*RJSZ
18310 CAMN [1.0]
18320 JRST MV250
18330 MOVN 1,RJSZ
18340 FMPR 1,[0.5]
18350 FADR 6,1 ;MINI NOTES NEED LESS SPACE
18500 MV250: SETZM ACCX# ; 250 ACCX=0
18600 SETZM RC# ; RC=0
18700 MOVE 1,JX ; RW=R(1,JX+1)
18710 ADD 1,1
18720 MOVE 7,XRN+=3500(1) ; 7=RW
18800 MOVE 10,JX ; DO 132 JJ=JX+1,N
18900 MVX132: MOVE 1,10 ; IF(RW.NE.R(1,JJ))GO TO 25
18910 ADD 1,1
18920 CAME 7,XRN+=3500(1)
18930 JRST MV25
19000 MOVE 6,XRN+=3501(1) ; KX=IR(2,JJ)
19100 ; GET POINTER
19200 MOVE 2,XRN(6) ; IF(RN(KX+1).NE.1)GO TO 25
19210 CAME 2,[1.0]
19220 JRST MV25 ;ONLY CHECK ON NOTES (THIS IS FOR CHRD NOTES WITH ACCIS)
19310 MOVM 4,XRN+5(2) ; RE=ABS(RN(KX+6))
19330 CAMGE 4,[10.0] ; IF(RE.GE.10)RC=-2.6
19335 JRST .+3
19337 MOVN [2.6]
19338 MOVEM RC
19340 CAMN 4,[20.0] ; IF(RE.EQ.20)RC=-RC
19345 MOVNS RC
19400 *********************** RE=AMOD(RN(KX+5),10.0)
19500 C FIND AN ACCI
19600 IF(RE.EQ.0)GO TO 132
19700 IF(RE.GE.1)RC=RC+2
19800 C FOUND AN ACCI
19900 CC ***** WHY WAS THIS *10????? RC=AMOD(RE,1.0)*10.0+RC
19910 RC=AMOD(RE,1.0)*10.0+RC
20000 C ADD ANY EXTENSION TO THE LEFT
20100 IF(RC.GT.ACCX)ACCX=RC
20200 RC=0
20250 IF(ACCX.GT.RD)RD=ACCX
20300 132 CONTINUE
20400 25 IF(JX.GT.0)R(2,JX)=R(2,JX)+RD*RSTJ2
20500 GO TO 17
20510 4 IF(RA.NE.2)GO TO 33
20530 C NEXT FOR DOTTED RESTS - IN P6
20540 IF(RN(L).GE.4)RB=RN(L+6)*1.5
20545 C NOW GO BACK TO SEE IF THERE IS A NOTE IN SAME HORIZ. POS.
20550 GO TO 250
20600 33 IF(RA.NE.3)GO TO 29
20700 RB=3
20800 IF(RX.GT.100)RB=1.5
20900 C CHECK ON SIZE NEEDED FOR CLEFS
21000 29 IF(RA.NE.4)GO TO 26
21100 RB=-RJSZ/2
21200 RD=.9
21300 GO TO 25
21400 26 IF(RA.NE.18)GO TO 30
21500 IF(RX6.GT.9)GO TO 31
21600 IF(RX.GT.9)GO TO 31
21700 C CHECKS FOR 2-DIGIT METERS
21800 RB=-1
21900 RD=1
22000 GO TO 25
22100 31 RB=2
22200 RD=3
22300 GO TO 25
22400 30 IF(RA.NE.17)GO TO 17
22500 RB=2*(ABS(RX)-1)-2
22600 C SPACES FOR CORRECT NUM OF ACCIS. RX=NUM OF ACCIS.
22700 RD=2
22800 GO TO 25
22820 C ↑↑↑↑↑ TO RESET AFTER CHORD NOTES 12/75
22900 17 RC=(RB+RJSZ)*RSTJ2
23000 C RJSZ=DEFAULT SIZE
23100 JX=K
23200 R(2,JX)=RC
23300 CC??????? R(1,JX)=R(1,K)
23400 3 IF(K.LT.N)GO TO 22
23500 RA=R(1,1)
23600 RB=R(2,1)
23700
23800 DO 13 KX=2,JX
23900 RE=R(1,KX)
24000 C POS. BEFORE SHIFTING
24100 IF(ABS(RE-RA).GT..5)GO TO 14
24200 IF(R(2,KX).GT.RB)GO TO 16
24300 C SKIPS DOUBLE STOPS AND VERY CLOSE ITEMS
24400 GO TO 13
24500 C JUMP WHEN SPACE TO ADD IS SMALLER THAN WHAT'S ALREADY THERE
24600 14 RD=RA+RB-RE
24700 IF(RD.LE.0)GO TO 16
24800 C THERE'S ENOUGH ROOM
24900 ROV=ROV+RD
25000 140 R4=RE+RSPC-.001
25100 R5=10000
25200 R8=RD
25300 R9=0
25400 C GO EXPAND IT
25500 IF(R(2,KX).EQ.0)GO TO 15
25600 CALL MOVIT
25700 IF(R2.LE.4)GO TO 15
25800 R5=R4
25900 R4=RA+.001+RSPC
26000 R8=R4
26100 R9=R5+RD-.001
26200 C FOR ITEMS ON OTHER LINES.
26300 CALL MOVIT
26400 15 RSPC=RSPC+RD
26500 C RSPC SAVES TOTAL SPACE ADDED
26600 16 RB=R(2,KX)
26700 13 RA=RE
26800 11 CONTINUE
26900 110 IF(ROV.LE.RRT+.01)RETURN
27000 IF(RJSZ.GT.4)RJSZ=4
27100 PRCNT=(ROV-RZRO)/(RRT-RZRO)
27200 IF(PRCNT.NE.RP)GO TO 19
27300 C GO BACK AND EXPAND SOME MORE
27400 101 R4=RZRO
27500 R5=ROV
27600 R8=RZRO
27700 R9=RRT-.001
27800 C JUSTIFYING SPACE DIMINISHES EACH TIME AROUND.
27900 CALL MOVIT
28000 C RVX SHOULD BE FARTHEST POINT TO RIGHT.
28100 1200 FORMAT(' MOVED TO STAFF ',F4.0/)
28200 CALL HYDPOG(3)
28300 5 FORMAT(' TYPE NEW STAFF #, POS1, POS2, UP-DOWN # '$)
28400 END